home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / feel0_89.lha / Feel / Modules / bignum.em next >
Lisp/Scheme  |  1993-07-18  |  3KB  |  135 lines
  1. ;; Eulisp Module
  2. ;; Author: JPB
  3. ;; File: bignum.em
  4. ;; Date: 20 May 93
  5. ;;
  6. ;; Project:  Feel interpreted module
  7. ;; Description: A Bignum package
  8. ;;
  9.  
  10. ;; defmodule, then the name of the module (must be the same as the file)
  11.  
  12. (defmodule bignum
  13.  
  14.   ;; what modules to import
  15.   ;; standard is most useful things
  16.   ;; describe allows us to find out about objects
  17.  
  18.   (eulisp0 describe)
  19.  
  20.   ;; The syntax section. This can be nil for us
  21.  
  22.   () 
  23.     
  24.   ;; Now the code. First define a bignum class, with a single slot which will
  25.   ;; be the list of digits for this number. It is a sub-class of number.
  26.   ;; The slot is called bignum-value, with accessor bignum-ref and predicate
  27.   ;; bignump.
  28.  
  29.   (defclass bignum
  30.     (<number>)
  31.  
  32.     ((bignum-value
  33.       initarg  bignum-initvalue
  34.       accessor bignum-ref
  35.     ))
  36.  
  37.     constructor (internal-make-bignum bignum-initvalue)
  38.     predicate   bignump
  39.   )
  40.     
  41.  
  42.   ;; Now write our own make-bignum, which takes an integer and turns it into a
  43.   ;; list of digits for use with internal-make-bignum
  44.  
  45.   (defun make-bignum (n)
  46.     (internal-make-bignum (integer-to-list n)))
  47.  
  48.  
  49.   ;; Routine to take a number and return it as a list of digits. Note that the
  50.   ;; LS digit is at the front.
  51.  
  52.   (defun integer-to-list (n)
  53.     (if (zerop n)
  54.       nil
  55.       (cons (remainder n 10) (integer-to-list (/ n 10)))) )
  56.  
  57.   ;; Now a method to add to binary+, so that it works with two bignums. This
  58.   ;; calls add-list, which takes two lists and a carry to add.
  59.  
  60.   (defmethod binary+ ((a bignum) (b bignum))
  61.     (internal-make-bignum (add-list (bignum-ref a) (bignum-ref b) 0)))
  62.  
  63.  
  64.   ;; A function to add two numbers represented as a list of digits (LS digit
  65.   ;; first) and construct a list of the result. The third argument is any
  66.   ;; carry to be added in.
  67.  
  68.   (defun add-list (a b c) (cond
  69.     ((null a)
  70.       (if (zerop c)
  71.         b
  72.         (add-list (list c) b 0)))
  73.     ((null b)
  74.       (if (zerop c)
  75.         a
  76.         (add-list a (list c) 0)))
  77.     (t (let ((tmp (+ (car a) (car b) c)))
  78.       (cons
  79.         (remainder tmp 10)
  80.         (add-list (cdr a) (cdr b) (/ tmp 10)))) )))
  81.  
  82.  
  83.   ;; A method to add to generic-write, so that it prints bignums
  84.  
  85.   (defmethod generic-write ((x bignum) s)
  86.     (write-list-number (bignum-ref x) s))
  87.  
  88.  
  89.   ;; A routine to write a number represented as a list, x, on a stream, s.
  90.  
  91.   (defun write-list-number (x s)
  92.     (cond
  93.       (x (progn
  94.         (write-list-number (cdr x) s)
  95.         (write (car x) s)))) )
  96.  
  97.  
  98.   ;; A method to add to generic-prin, so that it prints bignums
  99.       
  100.   (defmethod generic-prin ((x bignum) s)
  101.     (write-list-number (bignum-ref x) s))
  102.  
  103.  
  104.   ;; Now a fast version of fibonacci, which will be suitable for trying out
  105.   ;; the bignum package.
  106.  
  107.   (setq fib-tab (make <table> 'comparator = 
  108.               'hash-function (standard-hash-function)))
  109.  
  110.   ((setter table-ref) fib-tab 1 (make-bignum 1))
  111.   ((setter table-ref) fib-tab 2 (make-bignum 1))
  112.  
  113.   (defun fib (n)
  114.     (let ((val (table-ref fib-tab n)))
  115.     (cond
  116.       (val val)
  117.       (t (setq val (+ (fib (- n 1)) (fib (- n 2))))
  118.          ((setter table-ref) fib-tab n val)
  119.          val))))
  120.  
  121.   '(defmethod generic-hash ((n <integer>))
  122.     n)
  123.  
  124.   ;; Anything we wish to export
  125.  
  126.   ;; end module
  127.  
  128. )
  129.  
  130. (defconstant fib 
  131.   (let ((tab (make-table ..)))
  132.     (lambda () tab)))
  133.  
  134. (defun fib (n)
  135.   (local ((table (make-table